COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE EXTRA 
C00012 ENDMK
C⊗;
	SUBROUTINE EXTRA 
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL POS,GREG
	COMMON /STF/RSTFAC(8),RSTJ2
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(8),JJ2,POS
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RB,RZ,RJY,
	1 QQ,RJW,ZZ,JX,RG,KL,RJAC,K,L,RQ,RXO,J5X,RNO,JJJ,
	1 PUNCT,RDIS,RJ,ALF73
	EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(NJR,RJQ(8)),
	1 (J6,JQ(4)),(R8,RJQ(6)),(R7,RJQ(5)),(R9,RJQ(7)),(J9,JQ(7))
	1,(J4,JQ(2)),(R3,RJQ(1)),(J10,JQ(8)),(R11,RJQ(9)),(J8,JQ(6))
	1,(J7,JQ(5)),(RX3,RJQ(20)),(R5,RJQ(3)),(RH,RJQ(19)),(RXX,RJQ(18))
	1,(J3,JQ(1)),(NOLEDG,JQ(11)),(J11,JQ(9))
CC	DATA RBIG/1.5/,RLIG/2.0/

	IF(J4.GT.580)GO TO 1000
C JUMP FOR GREGORIAN NOTATION (J4=580:680)
	RBIG=1.5
	RLIG=2.0

	NOLEDG=J9
C   P9=-1 SUPRESSES LEDGER LINE
	IF(JA.EQ.2)R9=R7
	KL=IABS(J6)
	IF(KL.GT.5)GO TO 10
	IF(R9.GT.0)GO TO 2
10	IF(JA.EQ.1)J5=J6
	IF(KL.GE.30)GO TO 30
C  JUMP FOR MENSURATION SIGNS.
C  PUT NUM. IN P6 IF P9 NOT USED. 20=MAXIMA, 21=LONGA, 22=BREVIS, ETC.
	IF(R8.GE.0)R8=-2
C  MAKES IT WHITE UNLESS -1 IS IN R8
	GO TO 3
2	RH=.75
	DO 21 K=1,5
	IF(R9.NE.RH)GO TO 21
	R9=R9*2
	R9=R9/3.
	GO TO 22
21	RH=RH*2.
22	RA=AMOD(R9,.25)
C  RA=0=WHITE,  ≠0='COLORATION'
	IF(RA.NE.0)R9=R9*1.5
C  TO GET THE RIGHT SHAPE
	J5=19.5+ALOG(16./R9)/.693147181
C  I.E. /ALOG(2.)  FINDS SEQ. NUM IN DRAW FILE 'EARLY'. 20=MAXIMA, ETC.
	R8=-1
C  FILL IT ALWAYS (BLACK NOTE)
	IF(RA.EQ.0)R8=-2
C  ALWAYS WHITE
3	IF(JA.EQ.2)GO TO 20
	RH=R5
	JA=3 
	K=J4
	RXX=POS-18.*RSTJ2
	IF(J5.LT.20)GO TO 6
C GO MAKE 'LIGATURES' P6=11=1 UP, =-11=1 DOWN, 12=2 UP, ETC.
	R6=RBIG
	NJR='CLEF2'
C  ↑↑↑ EQUIV. TO R10
	R7=RBIG
	IF(R5)R6=-R6
C  IF P5 IS NEG THEN ITEM MOVES TO LEFT EXACTLY ITS SPACE.
	J9=0
       J8=R8
       IF(J8.NE.-1)J8=-2
	IF(J5.NE.29)GO TO 17
	R7=-R7
	R4=R4-5.8
C  MAKES LONGA WITH STEM UP -- FOR LIGATURES
	J5=21
	GO TO 7
17	IF(J5.LT.23)GO TO 7
	IF(R8.EQ.-2)R8=0
	IF(J8.EQ.-2)J8=0
C  FOR DIFFERENT 'FILL' SITUATIONS
7	IF(J11.EQ.0)GO TO 70
	JJ5=J5
	IF(R5.GE.20.)GO TO 72
C R5=10=STEM UP, =20=STEM DOWN - TURN NOTE OVER - ADJUST POSITION
	IF(R5.NE.10.0)GO TO 70
	IF(J5.NE.20)GO TO 70
	J5=126
C MAXIMA WITH STEM UP (IN CLEFM)
	R8=0
	GO TO 73
72	J5=J5+100
C +100 FOR STEMS DOWN ON MINIM AND SEMIMINIM (GOES TO FILE CLEFM.DMD)
73       CALL CLEFS
	J5=JJ5
	GO TO 71
70       CALL CLEFS
	IF(J5.LT.23)GO TO 18
71	IF(R8.GE.0)GO TO 1
	IF(J5.EQ.29)GO TO 1
	J5=29
	R6=RBIG
	R7=RBIG
C THIS PUTS 'MIDDLE' IN SEMIBREVE, MINIM AND SEMIMINIM
	GO TO 70

18	IF(J7.GE.0)GO TO 1
C IF P7 IS NEG THERE WILL BE A STEM ON LFT SIDE =ABS(R7), P5 HAS UP-DN.
	RG=R4
	R5=-J7*RST7
	GO TO 14
6	RG=R4
C THIS WILL BE FOR LIGATURE STEMS (P5=10=UP, =20=DOWN)
	IF(KL.GT.10)GO TO 11
	R6=-R6*10.
	GO TO 12
11	R6=KL-10
	IF(J6)R6=-R6
12	RX7=-.1
	IF(R6.LT.0)RX7=-RX7
	R4=R4+RX7
	R6=R6-RX7*2.
C  ABOVE TO ADJUST END POINTS OF TILTS.
	RX7=R7
	IF(J9.LT.0)R3=R3-27.*RSTJ2
C  J7=-1= SHIFT IT TO LEFT IT'S WIDTH.
	RA=R3
	IF(J8.LT.0)GO TO 9
	RJW=POS
5	R4=R4-.45
	J5=50
C  P8<0=BLACK LIG.   ≥0=WHITE LIG.
	J10=0
 	RXO=RLIG
	R8=3.9
	R11=R6
	R3=R3+13.85*RSTJ2
	RB=R3
	DO 55 JJJ=1,7 
	R9=RXO
	CALL ITMSUB
	POS=RJW
	R8=3.8
	R3=RB
55	RXO=RXO-.144
C  THICKENS HORIZ. SIDES
	R9=RXO
	GO TO 8
9	R4=R4-.95
	J9=0
	R5=R4+R6/RSTJ2
CC	R9=200
	J7=1
	R8=4.6
	R6=RX3+R8
	J10=14
C  MAKES SLOPED DASH, 14XTHICK
	IF(J9.EQ.0)GO TO 8
	R6=RX3
	J3=R3
8	CALL ITMSUB
	IF(RH.EQ.0)GO TO 13
	R5=ABS(RX7)
	IF(R5.EQ.0)R5=5
	R5=R5*RST7
14	RG=RG*RST7+RXX
	IF(RH.GE.20)R5=-R5
C NOW STEM IS DOWN. (-R5)
	CALL LINX(R3,RG,R3,RG+R5)
13	R4=RG
	J5=20
	R3=RA

1	IF(K.LT.502)GO TO 4
	IF(K.LT.513)RETURN
C  WILL NOW DO 1 LEDG. LINE ABOVE OR BELOW.
4	IF(NOLEDG)RETURN
	R4=RST7
	IF(K.GT.502)R4=13.*RST7
	R4=R4+RXX
	R5=20.
	IF(J5.EQ.20)R5=34.
	CALL LINX(R3-RST7,R4,R3+R5*RSTJ2,R4)

	RETURN

20	IF(R9.NE.0)J5=R5+23.
	RG=POS
C SAVE IT FOR SEMIMINIM REST HORIZANTAL
C  RESTS ARE SET BY RHYTHM(R9,7) OR IN J5 (20-25)
	R5=(J5-20)*2+3
	RA=R4
	IF(R5.GT.8.)R5=8.
	R5=R4+R5
C  RESTS (500+ IN P4) CAN BE MOVED UP OR DOWN
	R4=9
	IF(J5.GT.23)R4=7.
	R4=R4+RA
	J10=3
	J7=0
	R6=RX3
C ALL THIS MAKES VERT. LINE.
	CALL ITMSUB
	IF(J5.LT.25)RETURN
C NEXT IS FOR SEMIMINIM REST (1/16)
	R6=RX3+1.3
	R4=8+RA
	R5=R4
	POS=RG
	CALL ITMSUB
 	RETURN

C  MENSURATION SIGNS. USES P6 AS A NOTE. =30=C; 31=C.; 32=C/; 33=O; 34=O/
30	R4=R4+6
	CALL CENTX
C  P4=500 PUTS IT AT POS 6.
	R5=1
	J8=1
	IF(J5.GT.32)GO TO 31
C  NEXT ARE C'S
	J6=125
	J7=45
	GO TO 32
31	J6=0
	J7=0
32	CALL CIRCLE
	IF(J5.NE.31)GO TO 33
C  NEXT IS C.
	J5=0
	J6=0
	J7=0
	R5=.1
	GO TO 31
33	IF(J5.LT.32)RETURN
	IF(J5.EQ.33)RETURN
	R5=R4+1
	R4=R4-1
	R3=R3-11.*RSTJ2
	J7=0
	R6=RX3+2*RSTJ2
	CALL ITMSUB
	RETURN

C NEXT IS FOR CHANT NOTATION
1000	JA=11
	GREG=1.345*RSTJ2
	J5=J6
C USE J6 FOR ITEM CODE BECAUSE R6 IS ZEROED IN NTS.FAI
C R5 IS DISPLACEMENT TO RIGHT
C R7 IS STEM ON LEFT SIDE, R8 IS STEM ON RIGHT
	IF(R8.EQ.999.)R8=0
	RX8=R8
	RX7=R7
	R6=1.
	R7=1.
	R9=0
	R8=0
	J8=0
	NJR='GREGA'
	IF(R5.LE.0)GO TO 1003
C DISPLACEMENT TO RIGHT
	RXO=R5*GREG
CC	RXO=R5*RSTJ2
	R3=R3+5.96*RXO
	RX3=RX3+RXO
1003	CALL CLEFS
	IF(RX7.EQ.0)GO TO 1001
CX1002	R5=R4+RX7
C FOR VERTICAL LINE TO LEFT
1002	RXO=R4
	R4=R4-3.
	R7=RX7
	J5=6
	CALL CLEFS
	R4=RXO
CX	R3=IFIX(ROFF(RHORZ(RX3)))
CX	R6=RX3
CX	JA=4
CX	R7=0
CX	J7=0
CX	RXD=POS
C SAVE BOTTOM OF LINE.
CX	CALL ITMSUB
CX	POS=RXD
1001	IF(RX8.EQ.0)RETURN
C FOR VERTICAL LINE TO RIGHT
	R4=R4-3.
	R7=RX8
	J5=7
1004	CALL CLEFS
CC	RXO=2.
CC	IF(J6.GT.1)RXO=4.
Cx	RXO=GREG
CC	RXO=2.*RSTJ2
Cx	RX3=RX3+RXO
CC	R3=R3+5.96*RXO
C FOR VERTICAL LINE TO RIGHT
Cx	RX7=RX8
Cx	RX8=0
Cx	GO TO 1002
	END